home *** CD-ROM | disk | FTP | other *** search
/ Atari Forever 4 / Atari Forever 4.zip / Atari Forever 4.iso / PD_THEMA / BIORHYTM / BIORYTHM / BIORHY.BAS next >
BASIC Source File  |  1998-03-14  |  11KB  |  304 lines
  1. 10    ' TITELBLATT
  2. 20    dim tagzahl(13)
  3. 30    tagzahl(1)=31:tagzahl(2)=28:tagzahl(3)=31:tagzahl(4)=30
  4. 40    tagzahl(5)=31:tagzahl(6)=30:tagzahl(7)=31:tagzahl(8)=31
  5. 50    tagzahl(9)=30:tagzahl(10)=31:tagzahl(11)=30:tagzahl(12)=31
  6. 60    dim korx(500),kory(500),seey(500),geiy(500)
  7. 70    dim dkorx(500),dkory(500),dseey(500),dgeiy(500)
  8. 80    fullw 2:clearw 2
  9. 90    gotoxy 0,4
  10. 100   ?tab(28);"B I O R H Y T H M U S":?:?
  11. 110   linef 203, 59,395, 59
  12. 120   linef 203, 59,203, 98
  13. 130   linef 395, 59,395, 98
  14. 140   linef 203, 98,395, 98
  15. 160   dk$="Desk  File  Run  Edit  Debug                             "
  16. 165   de$=chr$(189)+" Dietmar Schell"
  17. 170   ?tab(30);de$
  18. 175   ?tab(21);"Gabriel-Biel-Str. 5, 7400 Tübingen":?
  19. 180   ?tab(15);"Das Programm stellt die drei Biorhythmus-Zyklen":?
  20. 190   ?tab(29);"den Körperzyklus,"
  21. 200   ?tab(29);"den Seelenzyklus und"
  22. 210   ?tab(29);"den Geistzyklus":?
  23. 220   ?tab(15);"für einen gewünschten Zeitraum graphisch dar. Die"
  24. 230   ?tab(15);"Graphik kann mit einem Nadeldrucker als Hardcopy mit"
  25. 240   ?tab(15);"den Befehlstasten ALTERNATE + HELP ausgedruckt werden."
  26. 250   w=inp(2)
  27. 255   ' ---------------------------------------------------------
  28. 260   ' EINGABE DER DATEN
  29. 270   desk$=dk$+de$
  30. 272   gosub ZEILE
  31. 275   clearw 2
  32. 280   gotoxy 0,3
  33. 290   ?"         Bitte geben Sie Ihren Namen ein:"
  34. 300   line input "         ",name$
  35. 310   if len(name$)>24 then gosub NAMEKORR
  36. 320   ?
  37. 330   input"         Bitte geben Sie Ihr Geburtsjahr ein (vierstellig)  ",jahr
  38. 340   if jahr<1850 goto 330
  39. 350   input"         Bitte geben Sie Ihren Geburtsmonat ein (als Zahl)  ",monat
  40. 360   if monat>12 goto 350
  41. 370   input"         Bitte geben Sie Ihren Geburtstag ein               ",tag
  42. 380   if tag>31 goto 370
  43. 390   ?:?:?"         Ab wann soll der BIORHYTHMUS dargestellt werden":?
  44. 400   input"         Bitte das Jahr eingeben (vierstellig)              ",biojahr
  45. 410   if biojahr<jahr goto 400
  46. 420   input"         Bitte den Monat eingeben (als Zahl)                ",biomonat
  47. 430   if biomonat>12 goto 420
  48. 440   if biojahr=jahr and biomonat<monat goto 420
  49. 450   input"         Bitte den Tag eingeben                             ",biotag
  50. 460   if biotag>31 goto 450
  51. 470   if biojahr=jahr and biomonat=monat and biotag<tag goto 450
  52. 475   ' ---------------------------------------------------------
  53. 480   ' AUSDRUCK GEBURTSTAG USW VORBEREITEN
  54. 490   monat$=right$(str$(monat),4)
  55. 500   biomonat$=right$(str$(biomonat),2)
  56. 510   tag$=right$(str$(tag),2)
  57. 520   biotag$=right$(str$(biotag),2)
  58. 530   jahr$=right$(str$(jahr),4)
  59. 540   biojahr$=right$(str$(biojahr),4)
  60. 550   geburt$=tag$+"."+monat$+"."+jahr$
  61. 560   biorh$=biotag$+"."+biomonat$+"."+biojahr$
  62. 565   ' ---------------------------------------------------------
  63. 570   ' ALTER IM GEBURTSJAHR
  64. 580   if biojahr>jahr then gosub GJAHR
  65. 590   if biojahr=jahr then gosub NEUGEB
  66. 595   ' ---------------------------------------------------------
  67. 600   ' AUSDRUCK DES ALTERS VORBEREITEN
  68. 610   alter$=right$("     "+str$(alter),6)
  69. 615   ' ---------------------------------------------------------
  70. 620   ' BERECHNUNG DER ANFANGSPUNKTE DER ZYKLEN
  71. 630   korper=(alter)mod(23)
  72. 640   seele =(alter)mod(28)
  73. 650   geist =(alter)mod(33)
  74. 655   ' ---------------------------------------------------------
  75. 656   ' MENUE
  76. 660   clearw 2
  77. 670   gotoxy 0,4
  78. 680   ?"         Wünschen Sie einen Monats-BIORHYTHMUS      1"
  79. 690   ?"         oder  einen   Drei-Monats-BIORHYTHMUS      2":?
  80. 700   ?"         Neue Daten eingeben                        3":?
  81. 710   ?"         Programm beenden                           4":?:?
  82. 720   linef 57,59,57,180
  83. 730   linef 57,59,435,59
  84. 740   linef 57,180,435,180
  85. 750   linef 435,59,435,180
  86. 760   ?:input"         Bitte wählen:                              ";wahl
  87. 770   on wahl gosub MOBIO,DREIBIO,275,790
  88. 780   goto 660
  89. 790   desk$=dk$+"                "
  90. 792   gosub ZEILE
  91. 793   end
  92. 795   ' ---------------------------------------------------------
  93. 800   GJAHR:
  94. 810   ' ALTER IM GEBURTSMONAT
  95. 820   alter=tagzahl(monat)-tag
  96. 825   ' ---------------------------------------------------------
  97. 830   ' ALTER IM GEBURTSJAHR
  98. 840   mhilf=monat+1
  99. 850   for x=mhilf  to 12
  100. 860   alter=alter+tagzahl(x)
  101. 870   next x
  102. 875   ' ---------------------------------------------------------
  103. 880   ' ALTER IM GEBURTSJAHR BEI SCHALTJAHR
  104. 890   if (jahr)mod(4)=0 and jahr<>1900 and monat<=2 then alter=alter+1
  105. 895   ' ---------------------------------------------------------
  106. 900   ' ALTER DER GANZEN JAHRE
  107. 910   alter=alter+(biojahr-jahr-1)*365
  108. 915   ' ---------------------------------------------------------
  109. 920   ' SCHALTJAHRE DER GANZEN JAHRE
  110. 930   for y=jahr+1 to biojahr-1
  111. 940   if (y)mod(4)=0 then alter=alter+1
  112. 950   next x
  113. 960   if jahr<1900 then alter=alter-1
  114. 965   ' ---------------------------------------------------------
  115. 970   ' ALTER IM BIORHYTHMUSJAHR
  116. 980   for x=1 to biomonat-1
  117. 990   alter=alter+tagzahl(x)
  118. 1000  next x
  119. 1010  alter=alter+biotag
  120. 1015  ' ---------------------------------------------------------
  121. 1020  ' ALTER IM BIORHYTHMUSJAHR BEI SCHALTJAHR
  122. 1030  if biomonat>2 and (biojahr)mod(4)=0 then alter=alter+1
  123. 1040  return
  124. 1045  ' ---------------------------------------------------------
  125. 1050  NEUGEB:
  126. 1060  alter=tagzahl(monat)-tag
  127. 1070  mhilf=monat+1
  128. 1080  for x=mhilf to biomonat-1
  129. 1090  alter=alter+tagzahl(x)
  130. 1100  next x
  131. 1110  alter=alter+biotag
  132. 1115  ' ---------------------------------------------------------
  133. 1120  ' KEIN SCHALTJAHR 1900
  134. 1130  if jahr=1900 goto 1160
  135. 1135  ' ---------------------------------------------------------
  136. 1140  ' SCHALTJAHR
  137. 1150  if (jahr)mod(4)=0 and monat<=2 and biomonat>2 then alter=alter+1
  138. 1160  if monat=biomonat then alter=biotag-tag
  139. 1170  return
  140. 1175  ' ---------------------------------------------------------
  141. 1180  MOBIO:
  142. 1190  clearw 2
  143. 1200  gotoxy 0,2
  144. 1205  gosub WEISS
  145. 1210  ?tab(12);"BIORHYTHMUS von ";name$;tab(53);"ab dem ";biorh$
  146. 1220  ?tab(12);"geboren am ";geburt$;"     Alter am ";biorh$;" :";alter$;" Tage"
  147. 1230  ?tab(12);"K =                 S =                 G ="
  148. 1240  rem DATUMZEILE BERECHNEN
  149. 1250  ?:?:?:?:?:?:?:?:?:?:?:?:?"       ";
  150. 1260  for y=biotag to tagzahl(biomonat) step 2
  151. 1270  print using "  ##";y;
  152. 1280  next y
  153. 1290  yhilf=1
  154. 1300  taghilf=tagzahl(biomonat)-biotag
  155. 1310  if (taghilf)mod(2)=0 then yhilf=2
  156. 1320  for y=yhilf to 31-taghilf step 2
  157. 1330  print using "  ##";y;
  158. 1340  next y
  159. 1345  ?
  160. 1346  linef 0,0,0,340
  161. 1350  linef 72,310,568,310
  162. 1360  linef 568,28,568,310
  163. 1370  linef 72,310,72,28
  164. 1380  linef 568,28,72,28
  165. 1390  linef 72,289,568,289
  166. 1400  linef 72,190,568,190
  167. 1410  linef 72, 91,568, 91
  168. 1420  linef 120, 78,168, 78
  169. 1430  linef 280, 78,328, 78
  170. 1440  linef 440, 78,488, 78
  171. 1450  circle 128, 78,1
  172. 1460  circle 144, 78,1
  173. 1470  circle 160, 78,1
  174. 1480  circle 288, 78,2
  175. 1490  circle 304, 78,2
  176. 1500  circle 320, 78,2
  177. 1510  for x=88 to 552 step 16
  178. 1520  linef x, 91,x,289
  179. 1530  next x
  180. 1540  pi=3.14159
  181. 1550  for k=0 to 496 step 8
  182. 1560  korx(k)=k+72
  183. 1570  kory(k)=190-50*sin(pi*2/496*k*31/23-pi/23+pi*2*korper/23)
  184. 1580  seey(k)=190-50*sin(pi*2/496*k*31/28-pi/28+pi*2*seele /28)
  185. 1590  geiy(k)=190-50*sin(pi*2/496*k*31/33-pi/33+pi*2*geist /33)
  186. 1600  next k
  187. 1610  for k=8 to 496 step 8
  188. 1620  linef korx(k-8),kory(k-8),korx(k),kory(k)
  189. 1630  linef korx(k-8),seey(k-8),korx(k),seey(k)
  190. 1640  linef korx(k-8),geiy(k-8),korx(k),geiy(k)
  191. 1650  next k
  192. 1660  for k=8 to 496 step 16
  193. 1670  circle korx(k),kory(k),1
  194. 1680  circle korx(k),seey(k),2
  195. 1690  next k
  196. 1700  w=inp(2)
  197. 1705  gosub ZEILE
  198. 1710  return
  199. 1715  ' ---------------------------------------------------------
  200. 1720  DREIBIO:
  201. 1730  clearw 2
  202. 1740  gotoxy 0,2
  203. 1745  gosub WEISS
  204. 1750  ?tab(12);"BIORHYTHMUS von ";name$;tab(53);"ab dem ";biorh$
  205. 1760  ?tab(12);"geboren am ";geburt$;"     Alter am ";biorh$;" :";alter$;" Tage"
  206. 1770  ?tab(12);"K =                 S =                 G ="
  207. 1780  ?:?:?:?:?:?:?:?:?:?:?:?
  208. 1790  ?tab(12);"Tages-, Wochen- und Monatslinien ab dem ";biorh$
  209. 1795  linef 0,0,0,340
  210. 1800  linef 72,310,562,310
  211. 1810  linef 562,28,562,310
  212. 1820  linef 72,310,72,28
  213. 1830  linef 562,28,72,28
  214. 1840  linef 72,289,562,289
  215. 1850  linef 72,190,562,190
  216. 1860  linef 72, 91,562, 91
  217. 1870  linef 120, 78,168, 78
  218. 1880  linef 280, 78,328, 78
  219. 1890  linef 440, 78,488, 78
  220. 1900  circle 128, 78,1
  221. 1910  circle 144, 78,1
  222. 1920  circle 160, 78,1
  223. 1930  circle 288, 78,2
  224. 1940  circle 304, 78,2
  225. 1950  circle 320, 78,2
  226. 1960  ' TAGESLINIEN
  227. 1970  for x= 77 to 562 step  5
  228. 1980  linef x,188,x,192
  229. 1990  next x
  230. 2000  ' WOCHENLINIEN
  231. 2010  for x=107 to 562 step 35
  232. 2020  linef x,185,x,195
  233. 2030  next x
  234. 2040  ' MONATSLINIEN
  235. 2050  zhilf=(tagzahl(biomonat)+1-biotag)*5+72
  236. 2060  if biomonat=2 and (biojahr)mod(4)=0 then zhilf=zhilf+5
  237. 2070  linef zhilf, 91,zhilf,289
  238. 2080  for zz=biomonat+1 to biomonat+3
  239. 2090  if zz=2 and (biojahr)mod(4)=0 then zhilf=zhilf+5
  240. 2100  if zz=14 and (biojahr+1)mod(4)=0 then zhilf=zhilf+5
  241. 2105  ztag=zz
  242. 2110  if zz>12 then ztag=zz-12
  243. 2120  zhilf=zhilf+tagzahl(ztag)*5
  244. 2130  if zhilf<562 then linef zhilf, 91,zhilf,289
  245. 2140  next zz
  246. 2150  pi=3.14159
  247. 2160  for k=0 to 490 step 5
  248. 2170  dkorx(k)=k+72
  249. 2180  dkory(k)=190-50*sin(pi*2/496*k*99.2/23-pi/23+pi*2*korper/23)
  250. 2190  dseey(k)=190-50*sin(pi*2/496*k*99.2/28-pi/28+pi*2*seele /28)
  251. 2200  dgeiy(k)=190-50*sin(pi*2/496*k*99.2/33-pi/33+pi*2*geist /33)
  252. 2210  next k
  253. 2220  for k=5 to 490 step 5
  254. 2230  linef dkorx(k-5),dkory(k-5),dkorx(k),dkory(k)
  255. 2240  linef dkorx(k-5),dseey(k-5),dkorx(k),dseey(k)
  256. 2250  linef dkorx(k-5),dgeiy(k-5),dkorx(k),dgeiy(k)
  257. 2260  next k
  258. 2270  for k=5 to 485 step 10
  259. 2280  circle dkorx(k),dkory(k),1
  260. 2290  circle dkorx(k),dseey(k),2
  261. 2300  next k
  262. 2310  w=inp(2)
  263. 2315  gosub ZEILE
  264. 2320  return
  265. 2325  ' ---------------------------------------------------------
  266. 2330  NAMEKORR:
  267. 2340  clearw 2
  268. 2350  gotoxy 0,4
  269. 2360  ?"         Der eingegebene Name ist zu lang! Bitte geben"
  270. 2370  ?"         Sie Ihren Namen neu ein, so daß er die Strich-
  271. 2380  ?"         leiste nicht überschreitet.":?
  272. 2385  gotoxy 0,8
  273. 2390  ?"         ________________________                                    "
  274. 2395  gotoxy 0,8
  275. 2400  line input"         ",name$
  276. 2410  if len(name$)>24 goto 2385
  277. 2420  return
  278. 2425  ' ---------------------------------------------------------
  279. 64000 WEISS:
  280. 64010 color 1,1,1,1,5
  281. 64020 poke contrl   ,11
  282. 64030 poke contrl+2 ,2
  283. 64040 poke contrl+6 ,0
  284. 64050 poke contrl+10,1
  285. 64060 poke ptsin  ,1
  286. 64070 poke ptsin+2,0
  287. 64080 poke ptsin+4,639
  288. 64090 poke ptsin+6,399
  289. 64100 vdisys
  290. 64110 return
  291. 64115 ' ---------------------------------------------------------
  292. 65200 ZEILE:
  293. 65231 for i=0 to 72
  294. 65232 poke intin+i*2,asc(mid$(desk$,i+1,1))
  295. 65234 next
  296. 65240 poke intin+i*2,0
  297. 65250 poke contrl, 8
  298. 65260 poke contrl+2,1
  299. 65270 poke contrl+6,74
  300. 65281 poke ptsin, 24
  301. 65286 poke ptsin+2, 14
  302. 65290 vdisys
  303. 65300 return
  304. ə